gVERSION = 3.00 _utility.h~*-1 _stringlibPixelsClass1_custom _stringlib_typelib _utility.h&~*-BArial, 1, 9, 6, 15, 12, 15, 3, 0 Arial, 0, 9, 5, 15, 12, 16, 3, 0 _graphbyrecord _utility.hPixelsClass8 _container_graphbyrecord_graphbyrecord _arraylibPixelsClass1_custom _arraylibName = "_arraylib" customLabel1_xtab _base.vcx chkShowLegendlabel>*trimcrlf Trims carriage returns and line feeds from string. .Height = 23 Width = 24 Name = "_stringlib" custom _base.vcx}PROCEDURE Click THIS.Parent.lAddLegend = THIS.Value ENDPROC PROCEDURE Init THIS.Value = THIS.Parent.lAddLegend ENDPROC Top = 248 Left = 19 Height = 17 Width = 90 BackStyle = 0 Caption = "\ T%C Ld T- T +aTC   H ! C  !2T  % ,BC ? B UASEARCHSEXPRNCOLUMNLRETROWNPOSinsaitem,delaitemacolscan18RA2AQQAaAaAqAAA2raAAq1!AAA36qqAqA1AAQAAQA2",3TE)7 2%:lLU T %s++C=C C=C  oTCC\A %++CRC CRC  TCCC>=` BUTCSTRING TLTRIMLEFT TLTRIMRIGHTLCSTRINGtrimcrlf,1qAAAAA2) _base.vcxWidth = 302 Height = 270 BorderWidth = 0 cgraphtitle = Record: ncharttype = 78 lseriesbyrow = .T. laddlegend = .T. cgraphfield = ccharttype = Name = "_graphbyrecord" coutfile = xtabquery lcursoronly = .T. lclosetable = .T. lshowthem = .T. nrowfield = 1 ncolfield = 2 ndatafield = 3 ntotaloption = 0 lbrowseafter = .T. Name = "_xtab" )csearchpath The folder path to begin searching for files. cfileexpression File skeleton for searching. Can include wildcards such as ? and *. csearchtext Text string to search for within files. lsubfolder Whether to search in subfolders for files. lignorecase Whether to ignore case during search. lwholewords Whether to search for whole word matches. ofiles Collection of files returned by Find search. lpromptdir Whether to prompt the user for search path if none entered. *find Runs search for files based on criteria. *csearchpath_access cgraphtitle Caption for record label. ncharttype Chart type (numeric value). lseriesbyrow Whether to plot series by column or row. laddlegend Whether to add a legend. cgraphfield Field to use for caption. ccharttype *setupgraph Initializes graph controls. *refreshgraph Refreshes graph when record pointer moved. ^adatafields[1,0] Array of data fields to graph. *lseriesbyrow_assign *ncharttype_assign *setcharttype Sets the chart type. *laddlegend_assign PROCEDURE runxtab LOCAL oNewXtab,lcxtabfile lcxtabfile = IIF(EMPTY(_GENXTAB),"vfpxtab.prg",_GENXTAB) oNewXtab=NEWOBJECT('genxtab',lcxtabfile,"",; THIS.cOutFile,; THIS.lCursorOnly,; THIS.lCloseTable,; THIS.lShowThem,; THIS.nRowField,; THIS.nColField,; THIS.nDataField,; THIS.lTotalRows,; THIS.nTotalOption,; THIS.lDisplayNulls) oNewXtab.MakeXtab() IF THIS.lBrowseAfter BROWSE NOWAIT NORMAL ENDIF ENDPROC ] DD%n*UCUTHISPARENT SETCHARTTYPE LISTINDEXCAreaC3D AreaCBarC3D BarCColumnC 3D ColumnCPieC3D PieCLineC3D Line T%CN TL H( LLTArea NsT3D Area 9TBar <T3D Bar 3TColumn 6 T 3D Column .TPie UT3D Pie yTLine T3D LineTUTHISADDITEM NGETVALUE LNCHARTTYPEPARENT NCHARTTYPEVALUEInteractiveChange,Initp1a3Aq1aa1aAq1QA11A111111a1A11AAA2Gb)DPROCEDURE InteractiveChange THIS.Parent.SetChartType(THIS.ListIndex) ENDPROC PROCEDURE Init THIS.AddItem(C_AREA_GRAPH) THIS.AddItem(C_AREA3D_GRAPH) THIS.AddItem(C_BAR_GRAPH) THIS.AddItem(C_BAR3D_GRAPH) THIS.AddItem(C_COLUMN_GRAPH) THIS.AddItem(C_COLUMN3D_GRAPH) THIS.AddItem(C_PIE_GRAPH) THIS.AddItem(C_PIE3D_GRAPH) THIS.AddItem(C_LINE_GRAPH) THIS.AddItem(C_LINE3D_GRAPH) LOCAL nGetValue,lnChartType nGetValue = THIS.Parent.nChartType IF VARTYPE(nGetValue)#"N" nGetValue = I_AREA_GRAPH ENDIF DO CASE CASE m.nGetValue= I_AREA_GRAPH &&Area lnChartType = C_AREA_GRAPH CASE m.nGetValue= I_AREA3D_GRAPH &&Area 3D lnChartType = C_AREA3D_GRAPH CASE m.nGetValue= I_BAR_GRAPH &&Bar lnChartType = C_BAR_GRAPH CASE m.nGetValue = I_BAR3D_GRAPH &&Bar 3D lnChartType = C_BAR3D_GRAPH CASE m.nGetValue = I_COLUMN_GRAPH &&Column lnChartType = C_COLUMN_GRAPH CASE m.nGetValue = I_COLUMN3D_GRAPH &&Column 3D lnChartType = C_COLUMN3D_GRAPH CASE m.nGetValue = I_PIE_GRAPH &&Pie lnChartType = C_PIE_GRAPH CASE m.nGetValue = I_PIE3D_GRAPH &&Pie 3D lnChartType = C_PIE3D_GRAPH CASE m.nGetValue = I_LINE_GRAPH &&Line lnChartType = C_LINE_GRAPH CASE m.nGetValue = I_LINE3D_GRAPH &&Line 3D lnChartType = C_LINE3D_GRAPH ENDCASE THIS.Value = lnChartType ENDPROC v ]]s%FXU %C0 J(TC% C BaB-U AVERARRAYNERRORTHIS CFILENAMEAVERSION T%CC O$T Comments: CC%CC :T C C Company Name: CC%CC >T C C File Description: CC%CC R:T C C File Version: CC%CC ;T C C Internal Name: CC%CC =T C C Legal Copyright: CC%CC Y>T C C Legal Trademarks: CC%CC ?T C C Original Filename: CC%CC   ;T C C Private Build: CC %CC  ^:T C C Product Name: CC %CC  =T C C Product Version: CC %CC   ;T C C Special Build: CC %CC ]6T C C  Language: CC/%C CTHIS.aVersion[1]bL *TNo version information found.1C Version information for: xU CVERSTRINGTHISAVERSION CFILENAME;%CTHIS.cFilenamebC C C0 TC;%CTHIS.cFilenamebC C C0 T BUTHIS CFILENAMEUTHISAVERSION getversion,displayversioncfilename_accessInit1!11qAAq3srAAqAqAqAqAqAqAqAqAqAqAqAqaAA3AA32-R <Gw ED P)] PROCEDURE getversion LOCAL aVerArray, nError IF FILE(THIS.cFileName) DIMENSION aVerarray[1] DIMENSION THIS.aVersion[15] STORE "" TO THIS.aVersion nError = AGetFileVersion(aVerArray,THIS.cFileName) IF m.nError # 0 ACOPY(aVerArray,THIS.aVersion) RETURN .T. ENDIF ENDIF RETURN .F. ENDPROC PROCEDURE displayversion *File Version Strings LOCAL cVerString cVerString = "" IF NOT EMPTY(THIS.aVersion(1)) cVerString = FILEVER_COMMENT_LOC + ALLT(THIS.aVersion(1)) ENDIF IF NOT EMPTY(THIS.aVersion(2)) cVerString = m.cVerString+CRLF+FILEVER_COMPANY_LOC+ ALLT(THIS.aVersion(2)) ENDIF IF NOT EMPTY(THIS.aVersion(3)) cVerString = m.cVerString+CRLF+FILEVER_FILEDESC_LOC+ ALLT(THIS.aVersion(3)) ENDIF IF NOT EMPTY(THIS.aVersion(4)) cVerString = m.cVerString+CRLF+FILEVER_FILEVER_LOC+ ALLT(THIS.aVersion(4)) ENDIF IF NOT EMPTY(THIS.aVersion(5)) cVerString = m.cVerString+CRLF+FILEVER_INTERNAL_LOC+ ALLT(THIS.aVersion(5)) ENDIF IF NOT EMPTY(THIS.aVersion(6)) cVerString = m.cVerString+CRLF+FILEVER_COPYRIGHT_LOC+ ALLT(THIS.aVersion(6)) ENDIF IF NOT EMPTY(THIS.aVersion(7)) cVerString = m.cVerString+CRLF+FILEVER_TRADMARK_LOC+ ALLT(THIS.aVersion(7)) ENDIF IF NOT EMPTY(THIS.aVersion(8)) cVerString = m.cVerString+CRLF+FILEVER_FILENAME_LOC+ ALLT(THIS.aVersion(8)) ENDIF IF NOT EMPTY(THIS.aVersion(9)) cVerString = m.cVerString+CRLF+FILEVER_PRIVATE_LOC+ ALLT(THIS.aVersion(9)) ENDIF IF NOT EMPTY(THIS.aVersion(10)) cVerString = m.cVerString+CRLF+FILEVER_PRODUCTNAME_LOC+ ALLT(THIS.aVersion(10)) ENDIF IF NOT EMPTY(THIS.aVersion(11)) cVerString = m.cVerString+CRLF+FILEVER_PRODUCTVER_LOC+ ALLT(THIS.aVersion(11)) ENDIF IF NOT EMPTY(THIS.aVersion(12)) cVerString = m.cVerString+CRLF+FILEVER_SPECIAL_LOC+ ALLT(THIS.aVersion(12)) ENDIF IF NOT EMPTY(THIS.aVersion(14)) cVerString = m.cVerString+CRLF+FILEVER_LANGUAGE_LOC+ ALLT(THIS.aVersion(14)) ENDIF IF EMPTY(m.cVerString) OR TYPE("THIS.aVersion[1]")="L" cVerString = FILEVER_NOVERSION_LOC ENDIF MESSAGEBOX(m.cVerString,MSG_FILEVERSION_LOC+THIS.cFileName) ENDPROC PROCEDURE cfilename_access *To do: Modify this routine for the Access method IF TYPE("THIS.cFilename")#"C" OR EMPTY(THIS.cFilename) OR !FILE(THIS.cFilename) THIS.cFilename = GETFILE() IF TYPE("THIS.cFilename")#"C" OR EMPTY(THIS.cFilename) OR !FILE(THIS.cFilename) THIS.cFilename = "" ENDIF ENDIF RETURN THIS.cfilename ENDPROC PROCEDURE Init DIMENSION THIS.aVersion[15] ENDPROC _PROCEDURE insaitem * Inserts an array element into an array. * * aArray - array name * sContents - contents to insert * iRow - row to insert into * lSetAll - whether to set all elements in row for multi-dime array LPARAMETER aArray,sContents,iRow,lSetAll LOCAL nColumns, i IF VARTYPE(iRow) # "N" iRow = ALEN(aArray) ENDIF nColumns = ALEN(aArray,2) DO CASE CASE iRow<0 RETURN CASE ALEN(aArray)=1 AND EMPTY(aArray[1]) aArray[1]=m.sContents CASE nColumns = 0 iRow = MIN(iRow,ALEN(aArray)) DIMENSION aArray[ALEN(aArray)+1] IF iRow # ALEN(aArray)-1 AINS(aArray,m.iRow+1) ENDIF aArray[m.iRow+1]=m.sContents OTHERWISE iRow = MIN(iRow,ALEN(aArray,1)) DIMENSION aArray[ALEN(aArray,1)+1,nColumns] IF iRow # ALEN(aArray,1)-1 AINS(aArray,m.iRow+1) ENDIF IF !lSetAll aArray[m.iRow+1,1]=m.sContents ELSE FOR i = 1 TO nColumns aArray[m.iRow+1,i]=m.sContents ENDFOR ENDIF ENDCASE ENDPROC PROCEDURE delaitem * Generic routine to delete an array element. If the array is * multi-dimensional, then a whole row is deleted. * * aArray- array to scan * wziRow - row to delete LPARAMETERS aArray,wziRow LOCAL nColumns IF ALEN(aArray,1)  Root EntryFPDOle AccessObjSiteData&8ChangedProps  !"#$%&')*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTU88 FMicrosoft Graph 97GBiff5MSGraph.Chart.89q  AB""$"#,##0_);\("$"#,##0\)!"$"#,##0_);[Red]\("$"#,##0\)""$"#,##0.00_);\("$"#,##0.00\)'""$"#,##0.00_);[Red]\("$"#,##0.00\)7*2_WorkbookCompObjbOlePres000(^ Ole ("$"* #,##0_);_("$"* \(#,##0\);_("$"* "-"_);_(@_).))_(* #,##0_);_(* \(#,##0\);_(* "-"_);_(@_)?,:_("$"* #,##0.00_);_("$"* \(#,##0.00\);_("$"* "-"??_);_(@_)6+1_(* #,##0.00_);_(* \(#,##0.00\);_(* "-"??_);_(@_)1Arial1Arial1Arial= ,##0.00_   A` J ` J 883ffff̙̙3f3fff3f3f33333f33333\R3&STUWYd((#= \>X43d 3QQQQ3_4E4 3QQQQ3_4E4 3QQQQ3_4E4D $% M 3O&Q4$% M 3O&Q4FAw 3Ow 3 b#M!  O43*#M! M! M MN43" :ddi3Oi% M3OQ423 M NM44444 #6     Y'H """)))UUUMMMBBB999|PP3f333f3333f3ffffff3f̙3ff333f333333333f33333333f33f3ff3f3f3f3333f33̙33333f333333f3333f3ffffff3f33ff3f3f3f3fff3ffffffffff3ffff̙fff3fffff3fff333f3f3ff3ff33f̙̙3̙ff̙̙̙3f̙3f333f3333f3ffffff3f̙3f3f3f333f3333f3ffffff3f̙3f3ffffffffff!___www45'  "Arial--"Systemn-'- Y-'- Y-'- U-'- Y "- - zPC> "---'--- yPC>---'--- yPC> "- -  QIJB---'--- yPC>---'--- yPC> "-3f -3f cI\B---'---3f yPC>---'---3f yPC> "- - uInB---'--- yPC>---'--- Y--' Y '  '   O%@ ob U%CCL0R, You must have a cursor selected.B-%CC (C..%CCEVAL(FIELD(m.i))bCLGDMT.%CC CTCC /C  TaTTTT T a T a T - T a C UITHIS ADATAFIELDS AUTOGRAPH LGRAPHRECORDNACTION LADDLEGEND LSERIESBYROW NCHARTTYPELSTRIPEXCESSLEGEND LUSE8TYPE LSHOWWHENDONE LKEEPFORM REFRESHGRAPH%CCB-TaTT T- Hr C  T aT C  C  T a>T C Record:Record: CCO_ 62 T -%C ~UCIGraph could not be generated. Try changing Chart Type or Plot By setting.x T TTaT-UTHISFORM LOCKSCREENTHIS AUTOGRAPH GRAPHPREVIEW OGRAPHREFOLEGRAPHOBJECT LADDEDDATA CGRAPHFIELD LADDTITLECTITLE CGRAPHTITLE MAKEOUTPUTVISIBLE[ %C LTT T CUVNEWVALTHIS LSERIESBYROW AUTOGRAPH REFRESHGRAPH[ %C NTT T CUVNEWVALTHIS NCHARTTYPE AUTOGRAPH REFRESHGRAPH%C N%B- T HP p TL  TN  T9  T<  T3  T6 0 T QT  q T  TTUNINDEX LNCHARTTYPE NCHARTVALUETHIS NCHARTTYPE[ %C LTT T CUVNEWVALTHIS LADDLEGEND AUTOGRAPH REFRESHGRAPH CUTHIS SETUPGRAPH setupgraph, refreshgraphlseriesbyrow_assignncharttype_assign setcharttype'laddlegend_assignInit1qqAcaAAqAAAA3qAA111AQAA3q!QA2q!QA3qrqA1111111111A3q!QA21Ps&':PIAQH Zf m )  PROCEDURE setupgraph LOCAL i IF EMPTY(ALIAS()) WAIT WINDOW C_NOALIAS_LOC TIMEOUT 2 RETURN .F. ENDIF * Check if no THIS.aDataFields array not populated by user. IF EMPTY(THIS.aDataFields[1]) FOR i = 2 TO FCOUNT() IF ATC(TYPE("EVAL(FIELD(m.i))"),"CLGDMT")#0 LOOP ENDIF IF !EMPTY(THIS.aDataFields[1]) DIMENSION THIS.aDataFields[ALEN(THIS.aDataFields)+1] ENDIF THIS.aDataFields[ALEN(THIS.aDataFields)] = FIELD(m.i) ENDFOR ENDIF ACOPY(THIS.aDataFields,THIS.Autograph.aDataFields) WITH THIS.autograph .lGraphRecord = .t. && graph just one record .nAction = 0 && preview/display mode .lAddlegend = THIS.lAddlegend && data is in rows .lSeriesByRow = THIS.lSeriesByRow && data is in rows .nChartType = THIS.nChartType && line chart .lStripExcessLegend = .t. && if MS Graph adds extra legends, get rid of them .lUse8Type = .t. && use documented graph types .lShowWhenDone = .F. && don't display (our form will handle it) .lKeepForm = .T. && don't reset form (use this one) ENDWITH THIS.RefreshGraph() ENDPROC PROCEDURE refreshgraph IF EMPTY(ALIAS()) RETURN .F. ENDIF THISFORM.LockScreen = .T. WITH THIS.Autograph .graphpreview = THISFORM && the form .oGraphRef = THIS.oleGraph.object && and the ole control object .lAddedData = .F. DO CASE CASE !EMPTY(THIS.cGraphField) .lAddTitle = .T. .cTitle = EVAL(THIS.cGraphField) CASE !EMPTY(THIS.cGraphTitle) .lAddTitle = .T. .cTitle = IIF(THIS.cGraphTitle=C_RECDESC_LOC,; C_RECDESC_LOC+" "+TRANS(RECNO()),THIS.cGraphTitle) OTHERWISE .lAddTitle = .F. ENDCASE IF !.MakeOutput() MESSAGEBOX(ERR_NOGRAPH_LOC) ENDIF .graphpreview = null .oGraphRef = null ENDWITH THIS.OleGraph.Visible = .T. THISFORM.LockScreen = .F. ENDPROC PROCEDURE lseriesbyrow_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal)="L" THIS.lseriesbyrow = m.vNewVal THIS.AutoGraph.lseriesbyrow = m.vNewVal THIS.RefreshGraph() ENDIF ENDPROC PROCEDURE ncharttype_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal)="N" THIS.ncharttype = m.vNewVal THIS.AutoGraph.ncharttype = m.vNewVal THIS.RefreshGraph() ENDIF ENDPROC PROCEDURE setcharttype LPARAMETER nIndex IF VARTYPE(m.nIndex)#"N" RETURN .F. ENDIF LOCAL lnChartType,nChartValue nChartValue = m.nIndex DO CASE CASE m.nChartValue = 1 &&Area lnChartType = I_AREA_GRAPH CASE m.nChartValue = 2 &&Area 3D lnChartType = I_AREA3D_GRAPH CASE m.nChartValue = 3 &&Bar lnChartType = I_BAR_GRAPH CASE m.nChartValue = 4 &&Bar 3D lnChartType = I_BAR3D_GRAPH CASE m.nChartValue = 5 &&Column lnChartType = I_COLUMN_GRAPH CASE m.nChartValue = 6 &&Column 3D lnChartType = I_COLUMN3D_GRAPH CASE m.nChartValue = 7 &&Pie lnChartType = I_PIE_GRAPH CASE m.nChartValue = 8 &&Pie 3D lnChartType = I_PIE3D_GRAPH CASE m.nChartValue = 9 &&Line lnChartType = I_LINE_GRAPH CASE m.nChartValue = 10 &&Line 3D lnChartType = I_LINE3D_GRAPH ENDCASE THIS.nChartType = lnChartType ENDPROC PROCEDURE laddlegend_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal)="L" THIS.lAddlegend = m.vNewVal THIS.AutoGraph.lAddlegend = m.vNewVal THIS.RefreshGraph() ENDIF ENDPROC PROCEDURE Init THIS.SetupGraph() ENDPROC cerrormessage Error message. ccomfile Name of COM file being. lhaderror Whether an error has happened. otliapp Object reference to type library reader application. otypelib Object reference to type library. ctypelib Name of type library. nclassref Numeric reference to selected class in classes array. oclass Object reference to class in type library. lskipalerts Whether to skip alerts. cclass Name of class. *alert Displays alert messagebox. ^aints[1,0] Array of interfaces. *checktliapp Checks and loads type library reader application. *checktypelib Checks and loads type library from COM server file. *getclasses Returns array of classes in specified type library. *checkclass Sets class as current one from a type library. *getmethods Returns array of methods in specified class of type library. *getparminfo Returns array of parameter info for a method in a class in specified type library. ^omethods[1,0] Object references array to methods of a class in type library. *vartypetostring Returns data type (string) from numeric reference. *checkvariant Checks if a variant data type is used in method for parameter or return type. *exporttypelib Method to export typelib to file. *getinvokekind  ||S %sFUR%C 4TKCxU TCMESSAGE STARTMODETHIS LSKIPALERTS CERRORMESSAGEg%CO`%TCtli.tliapplicationN%CO\B-UTHISOTLIAPP%C /B-%CCC }%C0 iB-T%CO$T-TC % CO T-B-T  T Ba%%CC C k%C0 gB-0%C OC fCf BaT-T aTCT -% CO gT-EC5File does not appear to contain a valid type library.B-T%B-T UETYPELIB LNCLASSCOUNT LOTYPELIB LCTYPELIBTHIS CHECKTLIAPPCTYPELIB LHADERROROTLIAPPINTERFACEINFOFROMOBJECTOTYPELIBPARENTCONTAININGFILE LIGNOREERRORSTYPELIBINFOFROMFILEALERT COCLASSESCOUNTu%C = B%CLc TT %e(a %:T  .C  2+T C  +T C   BU ACLASSESETYPELIB LRETURNPROGID LNCLASSESI LUSEPROGIDTHIS CHECKTYPELIBOTYPELIB COCLASSESCOUNTNAMEGUID%C CB-%CCC %%CN C  TT ( Ho .TC .C  f H"TCC   f2oTCC  f%CfT  TC  BaB-BCOUECLASS NCLASSTYPEETYPELIB LNCLASSTYPE LNCLASSESILCSTRLOCLASSTHIS CHECKTYPELIBOTYPELIB COCLASSESCOUNTNAMEDEFAULTINTERFACE NCLASSREFOCLASSb%C Q B TT %R  T(A HA* C    . # CC  A.TC%C T )TC  ,TC  )TC  #T C   T BUAMETHODSECLASS NCLASSTYPEETYPELIB LMETHODSONLYLINCLUDEHIDDENI LNMEMCOUNTLNMAXARRTHIS CHECKCLASSOCLASSMEMBERSCOUNTOMETHODS INVOKEKIND ATTRIBUTEMASKNAME RETURNTYPEVARTYPE HELPSTRINGv %CO8 BT%f T(bTC%C T&TC )TC  1TCC   BU APARMINFOOMETHOD LNPARMCOUNTILNMAXARR PARAMETERSCOUNTNAME VARTYPEINFOVARTYPEFLAGS H 5Bvariant S BNULL tBinteger  Blong Bsingle Bdouble Bcurrency  Bdate 2Bstring  SBVARIANT  tBboolean  Bvariant Bnumber Bnumber Bnumber Bnumber 6Binteger WBinteger u BVOID  BVOID2BvariantUNTYPE TC--a(%CC  B- "TCC   (%CC  B-U TCINTERFACELNMCOUNTLNPCOUNTLAMETHSLAPARMSIJTHIS GETMETHODS GETPARMINFOOMETHODS/     T-%C THIS.ctypelibbC C  8T CType Libraries: TLB,DLL,EXETypelib:%C  C 0  B!%C m.lNoViewFilebL  T -7%C m.cExportFilebCC m.cExportFile eT C .TXTTCSAFETYvG.%C  <, G` G`(;4 <> <>  "T C C  ( .' <>  "T C C   ( kd <>%  ", ";4<<") AS " +THIS.vartypetostring(laMethods[m.j, 2])>>QJ <>%CCC  (! <>G`(G`%C C SET SAFETY &cOldSafe %  C / : B U CEXPORTFILE LNOVIEWFILECOLDSAFEIJKLCTMPSTR LNCLASSES LACLASSES LNMETHODS LAMETHODSLAPARMSLNPARMSTHISCTYPELIB GETCLASSES GETMETHODS GETPARMINFOOMETHODS. H' 5BUnknown WBFunction |B PropertyGet B PropertyPut BPropertyPutRef B EventFunction  BCONST2'BUnknownUNKINDITTTTTUTHISOMETHODSOCLASSOTLIAPPOTYPELIBAINTSwTa2%CY C SBpBCUNERRORCMETHODNLINETHIS LHADERROR LIGNOREERRORS STARTMODEalert, checktliapp checktypelib4 getclasses checkclass getmethods? getparminfoz vartypetostringX checkvariant exporttypelib getinvokekindiDestroyError!1qA3QqAA3q"qAqAASqA1aqAS1qAAqAQqA1qA3bARAb1qAAA3{bqAQAaq!A1!qAAqAB3Aa1qA1AA11A1AA3QA21q11AaAA3qA3qqqA!qqAAA3qAAArAQaArQqqq!q!qAAAqAqAbaAA3qAAqaA23!AQA1C f<a PR mo pSv8$4$$;&}8Y&&>&')|'PROCEDURE alert LPARAMETERS tcMessage IF _VFP.StartMode#0 OR THIS.lSkipAlerts THIS.cErrorMessage = tcMessage ELSE MESSAGEBOX(tcMessage,16) ENDIF ENDPROC PROCEDURE checktliapp IF VARTYPE(THIS.oTLIApp)#"O" THIS.oTLIApp = CREATEOBJECT(TLIAPP_PROGID) IF VARTYPE(THIS.oTLIApp)#"O" RETURN .F. ENDIF ENDIF ENDPROC PROCEDURE checktypelib LPARAMETERS eTypelib LOCAL lnClassCount, loTypelib, lcTypelib IF !THIS.CheckTLIApp() RETURN .F. ENDIF * Check for valid typelib file passed IF VARTYPE(eTypelib)="C" AND !EMPTY(eTypelib) IF !FILE(eTypelib) RETURN .F. ENDIF THIS.cTypelib = eTypelib ENDIF * Check if user passed in an IDispath object instead of typelib name IF VARTYPE(eTypelib)="O" THIS.lHadError = .F. loTypelib = THIS.oTLIApp.InterfaceInfoFromObject(eTypelib) IF THIS.lHadError OR VARTYPE(loTypelib)#"O" THIS.lHadError = .F. RETURN .F. ENDIF THIS.oTypelib = loTypelib.Parent THIS.cTypelib = loTypelib.Parent.ContainingFile RETURN .T. ENDIF * Check for valid cTypelib property (possibly set) IF VARTYPE(THIS.cTypelib )="C" AND !EMPTY(THIS.cTypelib) IF !FILE(THIS.cTypelib) RETURN .F. ENDIF ENDIF * Check for valid oTypelib property IF VARTYPE(THIS.oTypelib)="O" AND UPPER(THIS.oTypelib.ContainingFile)==UPPER(THIS.cTypelib) RETURN .T. ENDIF * Need to check if valid THIS.lHadError = .F. THIS.lignoreerrors = .T. loTypelib = THIS.oTLIApp.TypeLibInfoFromFile(THIS.cTypelib) THIS.lignoreerrors = .F. IF THIS.lHadError OR VARTYPE(loTypelib)#"O" THIS.lHadError = .F. THIS.ALERT(BADTYPELIB_LOC) RETURN .F. ENDIF lnClassCount = loTypelib.CoClasses.Count IF lnClassCount=0 RETURN .F. ENDIF * Successful check, so let's set oTypelib property THIS.oTypelib = loTypelib ENDPROC PROCEDURE getclasses LPARAMETERS aClasses, eTypelib, lReturnProgID LOCAL lnClasses, i, lUseProgID IF !THIS.CheckTypeLib(eTypelib) RETURN 0 ENDIF IF VARTYPE(lReturnProgID)="L" lUseProgID = lReturnProgID ENDIF lnClasses = THIS.otypelib.CoClasses.Count IF lnClasses > 0 DIMENSION aClasses[lnClasses,2] FOR i = 1 TO lnClasses IF lUseProgID aClasses[m.i,1] = THIS.otypelib.Name + "." + THIS.otypelib.CoClasses(m.i).Name ELSE aClasses[m.i,1] = THIS.otypelib.CoClasses(m.i).Name ENDIF aClasses[m.i,2] = THIS.otypelib.CoClasses(m.i).GUID ENDFOR ENDIF RETURN lnClasses ENDPROC PROCEDURE checkclass LPARAMETERS eClass, nClassType, eTypelib * nClassType details: * 0 - eClass passed in is class name (default) * 1 - eClass passed in is progid name * 2 - eClass passed in is interface name * ex. for a ProgID of "VFPTEST.STOCK", pass in * 0 - "STOCK" * 1 - "VFPTEST.STOCK" * 2 - "ISTOCK" LOCAL lnClassType,lnClasses,i,lcStr,loClass IF !THIS.CheckTypeLib(eTypelib) RETURN .F. ENDIF IF VARTYPE(eClass)="C" AND !EMPTY(eClass) IF VARTYPE(nClassType)#"N" OR !BETWEEN(nClassType,0,2) lnClassType=0 ENDIF lnClasses = THIS.otypelib.CoClasses.Count FOR i = 1 TO lnClasses DO CASE CASE lnClassType=1 lcStr = UPPER(THIS.otypelib.Name+"."+THIS.otypelib.CoClasses(m.i).Name) CASE lnClassType=2 lcStr = UPPER(THIS.otypelib.CoClasses(m.i).DefaultInterface.Name) OTHERWISE lcStr = UPPER(THIS.otypelib.CoClasses(m.i).Name) ENDCASE IF UPPER(eClass)==lcStr THIS.nClassRef = m.i THIS.oClass = THIS.otypelib.CoClasses(m.i).DefaultInterface RETURN .T. ENDIF ENDFOR RETURN .F. ENDIF RETURN VARTYPE(THIS.oClass)="O" ENDPROC PROCEDURE getmethods LPARAMETERS aMethods, eClass, nClassType, etypelib, lMethodsOnly, lIncludeHidden * nClassType - see CheckClass method * populates aMethods array: * element 1 - name * element 2 - return type (numeric) * element 3 - help string * also populates THIS.aMethods array with obj refs * InvokeKind: * 0 - Unknown * 1 - Function * 2 - PropertyGet * 4 - PropertyPut * 8 - PropertyPutRef * 16 - EventFunction * 32 - CONST LOCAL i, lnMemCount, lnMaxArr IF !THIS.CheckClass(eClass, nClassType, eTypelib) RETURN 0 ENDIF lnMaxArr=0 lnMemCount = THIS.oClass.Members.Count IF lnMemCount > 0 DIMENSION aMethods[1,3] DIMENSION THIS.oMethods[1] aMethods="" FOR i = 1 TO lnMemCount * Skip hidden/restricted members (e.g., QueryInterface) DO CASE CASE m.lMethodsOnly AND THIS.oClass.Members(m.i).InvokeKind #1 && properties LOOP CASE m.lIncludeHidden CASE BITTEST(THIS.oClass.Members(m.i).AttributeMask, 0) && hidden and restricted LOOP ENDCASE lnMaxArr = ALEN(aMethods,1) IF !EMPTY(aMethods) lnMaxArr = lnMaxArr+1 DIMENSION aMethods[lnMaxArr,3] DIMENSION THIS.oMethods[lnMaxArr] ENDIF aMethods[lnMaxArr,1] = THIS.oClass.Members(m.i).Name aMethods[lnMaxArr,2] = THIS.oClass.Members(m.i).ReturnType.VarType aMethods[lnMaxArr,3] = THIS.oClass.Members(m.i).HelpString THIS.oMethods[lnMaxArr] = THIS.oClass.Members(m.i) ENDFOR lnMemCount = lnMaxArr ENDIF RETURN lnMemCount ENDPROC PROCEDURE getparminfo LPARAMETERS aParmInfo, oMethod * populates aParmInfoarray: * element 1 - name * element 2 - type (numeric) * element 3 - byref LOCAL lnParmCount,i,lnMaxArr IF VARTYPE(oMethod)#"O" RETURN 0 ENDIF lnParmCount = oMethod.Parameters.Count IF lnParmCount>0 DIMENSION aParmInfo[1,3] aParmInfo="" FOR i = 1 TO lnParmCount lnMaxArr = ALEN(aParmInfo,1) IF !EMPTY(aParmInfo) lnMaxArr = lnMaxArr+1 DIMENSION aParmInfo[lnMaxArr,3] ENDIF aParmInfo[lnMaxArr,1] = oMethod.Parameters(m.i).Name aParmInfo[lnMaxArr,2] = oMethod.Parameters(m.i).VarTypeInfo.VarType aParmInfo[lnMaxArr,3] = (BITAND(oMethod.Parameters(m.i).flags,3)=3) ENDFOR ENDIF RETURN lnParmCount ENDPROC PROCEDURE vartypetostring LPARAMETERS nType DO CASE CASE ntype = 0 && VT_EMPTY RETURN "variant" CASE ntype = 1 && VT_NULL RETURN "NULL" CASE ntype = 2 && VT_I2 RETURN "integer" CASE nType = 3 && VT_I4 RETURN "long" CASE nType = 4 && VT_R4 RETURN "single" CASE nType = 5 && VT_R8 RETURN "double" CASE nType = 6 && VT_CT RETURN "currency" CASE ntype = 7 RETURN "date" CASE ntype = 8 RETURN "string" CASE ntype = 9 && VT_DISPATCH RETURN "VARIANT" CASE nType = 11 RETURN "boolean" CASE nType = 12 && VT_VARIANT RETURN "variant" CASE nType = 16 && VT_I1 RETURN "number" CASE nType = 17 && VT_UI1 RETURN "number" CASE nType = 18 && VT_UI2 RETURN "number" CASE nType = 19 && VT_UI4 RETURN "number" CASE nType = 22 && VT_INT RETURN "integer" CASE nType = 23 && VT_UINT RETURN "integer" CASE nType = 24 && VT_VOID RETURN "VOID" CASE nType = 25 && VT_HRESULT RETURN "VOID" OTHERWISE RETURN "variant" ENDCASE ENDPROC PROCEDURE checkvariant LPARAMETERS tcInterface * Checks for Variant return type or parameter type which are not supported in SOAP. * Used for Web Services only since it doesn't check properties LOCAL lnMCount, lnPCount, laMeths, laParms, i, j DIMENSION laMeths[1] lnMCount = THIS.GetMethods(@laMeths,tcInterface, .F., .F., .T.) FOR i = 1 TO lnMCount * Check for valid return type -- fail for Currency or Variant IF INLIST(laMeths[m.i,2],6,12) RETURN .F. ENDIF DIMENSION laParms[1] lnPCount = THIS.GetParmInfo(@laParms,THIS.oMethods(m.i)) FOR j = 1 TO lnPCount * Check for valid parameter type IF INLIST(laParms[m.j,2],6,12) RETURN .F. ENDIF ENDFOR ENDFOR ENDPROC PROCEDURE exporttypelib * You can use this method to export the contents of a type library to a text file. LPARAMETER cExportFile, lNoViewFile LOCAL cOldSafe,i,j,k,lcTmpStr LOCAL lnClasses,laClasses,lnMethods,laMethods,laParms,lnParms lcTmpStr="" IF TYPE("THIS.ctypelib")#"C" OR EMPTY(THIS.ctypelib) THIS.ctypelib = GETFILE(GETFILE1_LOC,GETFILE2_LOC) ENDIF IF EMPTY(THIS.ctypelib) OR !FILE(THIS.ctypelib) RETURN "" ENDIF IF TYPE("m.lNoViewFile")#"L" m.lNoViewFile = .F. ENDIF IF TYPE("m.cExportFile")#"C" OR EMPTY("m.cExportFile") m.cExportFile = JustStem(THIS.ctypelib) + ".TXT" ENDIF cOldSafe = SET("SAFETY") SET SAFETY OFF IF WEXIST(m.cExportFile) RELEASE WINDOW (m.cExportFile) ENDIF SET TEXTMERGE ON NOSHOW SET TEXTMERGE TO MEMVAR lcTmpStr * Gather and output Typelib information \ <> <> DIMENSION laClasses[1] lnClasses=THIS.Getclasses(@laClasses) FOR i = 1 TO lnClasses \ <> <> \ DIMENSION laMethods[1] lnMethods=THIS.GetMethods(@laMethods,laClasses[m.i, 1]) FOR j = 1 TO lnMethods \ <> DIMENSION laParms[1] lnParms=THIS.Getparminfo(@laParms,THIS.oMethods[m.j]) FOR k = 1 TO lnParms \\ <> IF k < lnParms \\", " ENDIF ENDFOR \\<<") AS " +THIS.vartypetostring(laMethods[m.j, 2])>> \ <> IF !EMPTY(ALLTRIM(laMethods[m.j, 3])) \ <> ENDIF \ ENDFOR \ ENDFOR SET TEXTMERGE TO SET TEXTMERGE OFF IF !EMPTY(lcTmpStr) STRTOFILE(lcTmpStr, m.cExportFile) ENDIF SET SAFETY &cOldSafe IF !m.lNoViewFile AND !EMPTY(lcTmpStr) MODIFY FILE (m.cExportFile) NOWAIT ENDIF RETURN m.cExportFile ENDPROC PROCEDURE getinvokekind LPARAMETERS nKind DO CASE CASE nKind= 0 RETURN "Unknown" CASE nKind= 1 RETURN "Function" CASE nKind= 2 RETURN "PropertyGet" CASE nKind= 4 RETURN "PropertyPut" CASE nKind= 8 RETURN "PropertyPutRef" CASE nKind= 16 RETURN "EventFunction" CASE nKind= 32 RETURN "CONST" OTHERWISE RETURN "Unknown" ENDCASE ENDPROC PROCEDURE Destroy THIS.omethods = null THIS.oclass = null THIS.otliapp = null THIS.otypelib = null THIS.aInts = null ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.lhaderror = .T. IF THIS.lIgnoreErrors OR INLIST(nError,1113, 1426, 2012) OR _VFP.StartMode>0 RETURN ELSE RETURN DODEFAULT(nError, cMethod, nLine) ENDIF ENDPROC